home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / map2use.exe / MAP2USES.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-02-16  |  7.9 KB  |  295 lines
  1. { File Map2Uses.pas }
  2. { 10-Jan-1991 J. K. Welsh }
  3.  
  4. { This program reads a .MAP file produced by the Turbo Pascal compiler, and
  5.   creates an optimized Uses list. It also lists all of the "uses" units in
  6.   overlay format, excepting those you specify below. }
  7.  
  8. { Activate only one of the following }
  9. {..$Define UseTpro}
  10. {$Define UseOpro}
  11.  
  12. {.$Define Debug}
  13. {$IfDef Debug}
  14. {$D+}
  15. {$L+}
  16. {$S+}
  17. {$R+}
  18. {$EndIf}
  19.  
  20. program Map2Uses;
  21.  
  22.   {$I-}
  23.  
  24. uses
  25.   Dos,
  26.  
  27.   {$IfDef UseTpro}
  28.   tpinline,
  29.   tpcrt,
  30.   tpstring,
  31.   tpdos,
  32.   tpasciiz;
  33.   {$Endif}
  34.  
  35.   {$IfDef UseOpro}
  36.   Opinline,
  37.   Opcrt,
  38.   Opstring,
  39.   Opdos,
  40.   Opasciiz;
  41.   {$Endif}
  42.  
  43. const
  44.   OutExt              : String[4] = '.USE';
  45.   MapExt              : String[4] = '.MAP';
  46.   Indent1             = '  ';
  47.   Indent2             = '     ';
  48.  
  49.   MaxUnits            = 400;
  50.   UnitNamePos         = 21;       { Change if the .MAP file format changes }
  51.  
  52.   { The following are not to be placed in the uses list.
  53.     They must be in lowercase. }
  54.   BadNames            = 'name system data stack heap';
  55.  
  56.   { The following are not to be overlaid. They will all be combined into a
  57.     single AsciiZ string at the start of the program. This is not a definitive
  58.     list. You should "tune" it based upon your needs. These names must all
  59.     be in lowercase. }
  60.  
  61.   Lib1NoOverlay       = 'overlay tpinline tpcrt tpstring tpmouse tpcmd tpedit tppick tpentry';
  62.   Lib2NoOverlay       = 'opinline opcrt opstring opmouse opcmd tpedit oppick opentry opxms opexec';
  63.   FilerNoOverlay      = 'filer vrec isamtool browser ';
  64.   PubDomainNoOverlay  = 'shrink extend tpstack';
  65.   My1NoOverlay        = '';
  66.   My2NoOverlay        = '';
  67.  
  68.   { If you wish mixed upper and lower case names, use these. Lower case only here. }
  69.   UpLib3              = 'tp op oo ap'; { Uppercase the third letter for these }
  70.   UpLib4              = 'lzh zip'; { Uppercase the fourth letter for these }
  71.   UpLib5              = '';       { Uppercase the fifth letter for these }
  72.  
  73. type
  74.   Str8                = String[8];
  75.  
  76. var
  77.   UnitNames           : array[1..MaxUnits] of Str8;
  78.   LastName, UnitName  : Str8;
  79.   InFileName, OutFileName : Pathstr;
  80.   InFile, OutFile     : Text;
  81.   Name                : NameStr;
  82.   Finished, OverLayIt,
  83.   UnitNameOk          : Boolean;
  84.   LineCount, UnitCount : LongInt;
  85.   Ext                 : ExtStr;
  86.   Dir                 : DirStr;
  87.   LastChar, ThisChar  : Char;
  88.   s                   : String;
  89.   I, J                : Word;
  90.   Az, Bz              : AsciiZ;
  91.   IoStatus            : Integer;
  92.  
  93.   { ----- }
  94.   function Up_Case(Un : Str8) : Str8;
  95.     { Just some "pretty printing". Change to suit. }
  96.  
  97.   var
  98.     s2                  : String[2];
  99.     s3                  : String[3];
  100.     s4                  : String[4];
  101.  
  102.   begin
  103.     s2 := Copy(Un, 1, 2);
  104.     s3 := Copy(Un, 1, 3);
  105.     s4 := Copy(Un, 1, 4);
  106.  
  107.     Un[1] := Upcase(Un[1]);       { Always Upcase the first letter }
  108.  
  109.     if (Pos(s4, UpLib5) > 0) then
  110.       Un[5] := Upcase(Un[5])
  111.     else
  112.       if (Pos(s3, UpLib4) > 0) then
  113.         Un[4] := Upcase(Un[4])
  114.     else
  115.       if (Pos(s2, UpLib3) > 0) then
  116.         Un[3] := Upcase(Un[3]);
  117.  
  118.     Up_Case := Un;
  119.   end;                            { function Up_Case }
  120.  
  121.   { ----- }
  122.   procedure Write_Usage;
  123.   begin
  124.     WriteLn('Usage Map2Uses InFileName [OutFileName]');
  125.     Halt
  126.   end;
  127.  
  128.  
  129. begin                             { ----- main program Map2Uses ----- }
  130.   ClrScr;
  131.  
  132.   if ParamCount < 1 then
  133.     Write_Usage;
  134.  
  135.   InFileName := FExpand(ParamStr(1));
  136.   FsPlit(InFileName, Dir, Name, Ext);
  137.  
  138.   if Ext = '' then
  139.     begin
  140.       InFileName := InFileName + MapExt;
  141.       FsPlit(InFileName, Dir, Name, Ext);
  142.     end;
  143.  
  144.   if Ext <> MapExt then
  145.     begin
  146.       WriteLn('Input file must be a ', MapExt, ' file.');
  147.       WriteLn(InFileName);
  148.       Halt;
  149.     end;
  150.  
  151.   if ParamCount < 2 then
  152.     OutFileName := FExpand(Name + OutExt)
  153.   else
  154.     OutFileName := FExpand(ParamStr(2));
  155.  
  156.   if not ExistFile(InFileName) then
  157.     Write_Usage;                  { Halt with message }
  158.  
  159.   WriteLn('Reading from    ', InFileName);
  160.   WriteLn('Writing to      ', OutFileName);
  161.   WriteLn;
  162.   WriteLn;
  163.  
  164.   FillChar(UnitNames, SizeOf(UnitNames), 0);
  165.   LineCount := 0;
  166.   UnitCount := 0;
  167.  
  168.   { Take our lists of units that are not to be overlaid and build them into }
  169.   { one AsciiZ array }
  170.   FillChar(Az, SizeOf(Az), 0);
  171.   ConcatStr(Az, Lib1NoOverlay, Bz);
  172.   ConcatStr(Bz, Lib2NoOverlay, Az);
  173.   ConcatStr(Az, FilerNoOverlay, Bz);
  174.   ConcatStr(Bz, PubDomainNoOverlay, Az);
  175.   ConcatStr(Az, My1NoOverlay, Bz);
  176.   ConcatStr(Bz, My2NoOverlay, Az);
  177.  
  178.   Assign(InFile, InFileName);
  179.   Reset(InFile);
  180.   IoStatus := IoResult;
  181.   if (IoStatus <> 0) then
  182.     begin
  183.       WriteLn('Error #', IoStatus, ' resetting "', InFileName, '".');
  184.       Halt(IoStatus);
  185.     end;
  186.  
  187.   Assign(OutFile, OutFileName);
  188.   Rewrite(OutFile);
  189.   IoStatus := IoResult;
  190.   if (IoStatus <> 0) then
  191.     begin
  192.       WriteLn('Error #', IoStatus, ' rewriting "', OutFileName, '".');
  193.       Halt(IoStatus);
  194.     end;
  195.  
  196.   Finished := False;
  197.  
  198.   repeat                          { Until finished }
  199.     ReadLn(InFile, s);
  200.     Inc(LineCount);
  201.  
  202.     Finished := EoF(InFile);
  203.     if Finished = False then
  204.       begin
  205.         s := Trim(s);
  206.         { Stop at first blank line after unit name section of map file. }
  207.         if (Length(s) = 0) then
  208.           if LineCount > 4 then
  209.             Finished := True;
  210.  
  211.         if Finished = False then
  212.           if (Length(s) > 0) then
  213.             begin
  214.               Delete(s, 1, UnitNamePos);
  215.               s := Copy(s, 1, 8);
  216.               s := StLocase(Trim(s)); { Unit name }
  217.               UnitNameOk := (Pos(s, BadNames) = 0); { Searching within a normal turbo string }
  218.               if UnitNameOk then
  219.                 begin
  220.                   Inc(UnitCount);
  221.                   UnitNames[UnitCount] := s;
  222.                 end;              { if UnitNameOk }
  223.             end;                  { Length(s) > 0 }
  224.       end;                        { if Finished = False }
  225.   until Finished;
  226.  
  227.   { All unit names read into array }
  228.   { Write out the unit names in reverse order for a Uses list. }
  229.  
  230.   LastChar := ' ';
  231.   WriteLn(OutFile, Indent1, 'Uses');
  232.  
  233.   { UnitNames[1] is program name, discard }
  234.   { UnitNames[2] is printed outside of this loop because it has a trailing ; }
  235.  
  236.   for I := UnitCount downto 3 do
  237.     begin
  238.       UnitName := UnitNames[I];
  239.       ThisChar := Upcase(UnitName[1]);
  240.  
  241.       if ThisChar <> LastChar then
  242.         WriteLn(OutFile);         { Just for formatting }
  243.  
  244.       UnitName := Up_Case(UnitName);
  245.  
  246.       WriteLn(OutFile, Indent2, UnitName, ',');
  247.       WriteLn(Indent2, UnitName, ',');
  248.  
  249.       LastChar := UnitName[1];
  250.     end;
  251.  
  252.   WriteLn(OutFile, Indent2, UnitNames[2], ';'); { Last item in list ends with ; }
  253.  
  254.   WriteLn(OutFile);
  255.   WriteLn(OutFile);
  256.  
  257.   { Last one is program name }
  258.   { Second last one is first unit }
  259.   for I := UnitCount downto 2 do
  260.     begin
  261.       UnitName := UnitNames[I];
  262.       ThisChar := Upcase(UnitName[1]);
  263.  
  264.       if ThisChar <> LastChar then
  265.         WriteLn(OutFile);         { Blank line for formatting }
  266.  
  267.       OverLayIt := (PosStr(UnitName, Az) = NotFound);
  268.       UnitName := Up_Case(UnitName);
  269.  
  270.       { Usually, the unit immediately following the Overlay unit is a special
  271.         user defined unit for doing special things with the overlay unit. It
  272.         should not be overlaid. Such a special unit is required if any
  273.         overlaid units contain intialization code. }
  274.  
  275.       if OverLayIt then
  276.         if LastName = 'Overlay' then
  277.           OverLayIt := False;
  278.  
  279.       if OverLayIt then
  280.         WriteLn(OutFile, Indent2, '{$O ', UnitName, '}')
  281.       else
  282.         WriteLn(OutFile, Indent2, '{.$O ', UnitName, '}');
  283.  
  284.       LastChar := UnitName[1];
  285.       LastName := UnitName;
  286.     end;
  287.  
  288.   Close(OutFile);
  289.   Close(InFile);
  290.  
  291.   {$I+}
  292.  
  293. end.                              { ----- Program Map2Uses ----- }
  294.  
  295.